home *** CD-ROM | disk | FTP | other *** search
/ Chip 1996 November / CHIP Kasım 1996.iso / prog / as22p / woplus.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-28  |  14KB  |  561 lines
  1. {WOPLUS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WOPlus;
  3. {$R woplus.res}
  4.  
  5. {******************************************************************}
  6. { I N T E R F A C E                                                }
  7. {******************************************************************}
  8. interface
  9. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,
  10.       WFPlus;
  11. const
  12.     sr_Recessed     =   1;
  13.   sr_Raised       =   0;
  14. type
  15. PODButton = ^TODButton;
  16. TODButton = object(TButton)
  17.     HBmp :HBitmap;
  18.   State:Integer;
  19.   constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  20.       X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  21.   destructor    Done;virtual;
  22.   procedure    DrawItem(var Msg:TMessage);virtual;
  23. end;
  24.  
  25.  
  26. type
  27.     PTextObj = ^TTextObj;
  28.   TTextObj = object(TObject)
  29.   Text:PChar;
  30.       constructor Init(NewText:PChar);
  31.     destructor Done;virtual;
  32.     end;
  33.  
  34. type
  35.     PIntObj = ^TIntObj;
  36.   TIntObj = object(TObject)
  37.       Int:Integer;
  38.     constructor Init(NewInt:Integer);
  39.     destructor Done;virtual;
  40.     end;
  41.  
  42. type
  43.     PStack = ^TStack;
  44.     TStack = object(TCollection)
  45.        procedure Push(Item:Pointer);virtual;
  46.     function Pop:Pointer;virtual;
  47.    end;
  48.  
  49.  
  50. {TTextStream}
  51. type
  52. PTextStream = ^TTextStream ;
  53. TTextStream = object(TBufStream)
  54.    CharsToRead : LongInt;
  55.    CharsRead : LongInt;
  56.    ARecord :PChar;
  57.    constructor Init(FileName:PChar;Mode,Size:Word);
  58.    destructor Done;virtual;
  59.    function GetNext:PChar;virtual;
  60.    function WriteNext(szARecord:PChar):integer;virtual;
  61.    function WriteEOF:integer;virtual;
  62.    function IsEOF:Boolean;virtual;
  63.    function GetPctDone:Integer;
  64. end;
  65.  
  66.  
  67. {TMeter}
  68. type
  69. PMeterWindow = ^TMeterWindow;
  70. TMeterWindow = object(TWindow)
  71.   TheRedBrush:HBrush;
  72.   TheGrayBrush:Hbrush;
  73.   ThePen:HPen;
  74.   X,Y,dX,dY,mX :Integer;
  75.   PctDone :Integer;
  76.   Icon:HIcon;
  77.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  78.   procedure   SetupWindow;virtual;
  79.   destructor  Done; virtual;
  80.   procedure   Draw(NewPctDone:Integer);virtual;
  81.   procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  82. end;
  83.  
  84. type
  85. PSRect = ^TSRect;
  86. TSRect = object(TWindow)
  87.   W,H:Integer;
  88.     State:Integer;
  89.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  90.       NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  91.   destructor Done;virtual;
  92.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  93.   procedure SetupWindow;virtual;
  94. end;
  95.  
  96. type
  97. PSText = ^TSText;
  98. TSText = object(TSRect)
  99.     Text:Array [0..80] of Char;
  100.   DTStyle:Integer;
  101.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  102.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  103.   destructor Done;virtual;
  104.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  105.   procedure SetText(NewText:PChar);virtual;
  106. end;
  107.  
  108.  
  109. {********************************************************************}
  110. {I M P L E M E N T A T I O N                                                     }
  111. {********************************************************************}
  112. implementation
  113.  
  114. {********************************************************************}
  115.  
  116. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  117.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  118. begin
  119.     TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  120.   Attr.Style := Attr.Style or bs_OwnerDraw;
  121.   HBmp := LoadBitmap(HInstance,BMP);
  122. end;
  123.  
  124. destructor    TODButton.Done;
  125. begin
  126.     TButton.Done;
  127.     DeleteObject(HBmp);
  128. end;
  129.  
  130.  
  131. procedure    TODButton.DrawItem(var Msg:TMessage);
  132. var
  133.     TheDC:HDc;
  134.     ThePen:HPen;
  135.   Pen1:HPen;
  136.   Pen2:HPen;
  137.   TheBrush :HBrush;
  138.   OldBrush :HBrush;
  139.   OldPen:HPen;
  140.   OldBitMap:HBitMap;
  141.   MemDC :HDC;
  142.   LPts:Array[0..2] of TPoint;
  143.   RPts:Array[0..2] of TPoint;
  144.   PDIS :^TDrawItemStruct;
  145.   X,Y,W,H:Integer;
  146.   PenWidth,OffSet:Integer;
  147.   DBU:LongRec;
  148. begin
  149.     LongInt(DBU) := GetDialogBaseUnits;
  150.     PDIS := Pointer(Msg.lParam);
  151.   if PDIS^.itemAction = oda_Focus then Exit;
  152.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  153.       ((PDIS^.itemState and ods_Selected) > 0) then
  154.       State := 1 else State := 0;                     {1 = depressed}
  155.  
  156.   X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
  157.   W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  158.   H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  159.   OffSet := Round(H / (DBU.lo * 4));
  160.   PenWidth := OffSet;
  161.  
  162.   LPts[0].x := W; LPts[0].y := 0;
  163.   LPts[1].x := 0; LPts[1].y := 0;
  164.   LPts[2].x := 0; LPts[2].y := H;
  165.   RPts[0].x := 0; RPts[0].y := H;
  166.   RPts[1].x := W; RPts[1].y := H;
  167.   RPts[2].x := W; RPts[2].y := 0;
  168.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  169.   OldBitMap := SelectObject(MemDC,HBMP);
  170.   if State = 0 then
  171.         BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  172.   else
  173.       BitBlt(PDIS^.HDC,X+OffSet,Y+OffSet,W,H, MemDC,0,0,SrcCopy);
  174.   SelectObject(MemDC,OldBitMap);
  175.   DeleteDC(MemDC);
  176.  
  177.     Pen1 := CreatePen(ps_Solid,OffSet,$00000000);
  178.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  179.   PolyLine(PDIS^.HDC,LPts,3);
  180.   PolyLine(PDIS^.HDC,RPts,3);
  181.   SelectObject(PDIS^.HDC,OldPen);
  182.   DeleteObject(Pen1);
  183.  
  184.   LPts[0].x := W-OffSet;     LPts[0].y := OffSet;
  185.   LPts[1].x := OffSet;         LPts[1].y := OffSet;
  186.   LPts[2].x := OffSet;        LPts[2].y := H-OffSet;
  187.   RPts[0].x := OffSet;         RPts[0].y := H-OffSet;
  188.   RPts[1].x := W-OffSet;     RPts[1].y := H-OffSet;
  189.   RPts[2].x := W-OffSet;     RPts[2].y := OffSet;
  190.   if State = 0 then
  191.       begin
  192.         Pen1 := CreatePen(ps_Solid,PenWidth,$00FFFFFF);       {white hilite}
  193.     Pen2 := CreatePen(ps_Solid,PenWidth,$00808080);
  194.     end
  195.   else
  196.       begin
  197.       Pen1 := CreatePen(ps_Solid,PenWidth,$00808080);       {black hilite}
  198.         Pen2 := CreatePen(ps_Solid,Penwidth,$00808080);
  199.     end;
  200.  
  201.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  202.   PolyLine(PDIS^.HDC,LPts,3);
  203.  
  204.   SelectObject(PDIS^.HDC,Pen2);
  205.   DeleteObject(Pen1);
  206.  
  207.   PolyLine(PDIS^.HDC,RPts,3);
  208.   SelectObject(PDIS^.HDC,OldPen);
  209.   DeleteObject(Pen2);
  210. end;
  211.  
  212. {***********************************************************************}
  213. constructor TTextObj.Init(NewText:PChar);
  214. begin
  215.     Text := StrNew(NewText);
  216. end;
  217.  
  218. destructor TTextObj.Done;
  219. begin
  220.     StrDispose(Text);
  221. end;
  222.  
  223. {***********************************************************************}
  224. constructor TIntObj.Init(NewInt:Integer);
  225. begin
  226.     Int := NewInt;
  227. end;
  228.  
  229. destructor TIntObj.Done;
  230. begin
  231.  
  232. end;
  233. {***********************************************************************}
  234. procedure TStack.Push(Item:Pointer);
  235. begin
  236.     AtInsert(0,Item);
  237. end;
  238.  
  239. function TStack.Pop:Pointer;
  240. begin
  241.     Pop := At(0);
  242.   AtDelete(0);
  243. end;
  244.  
  245.  
  246. {***********************************************************************}
  247. {TTextStream Methods}
  248. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  249. begin
  250.     TBufStream.Init(FileName,Mode,Size);
  251.   CharsRead := 0;
  252.   CharsToRead := TBufStream.GetSize;
  253.   ARecord := MemAlloc(32000);
  254. end;
  255.  
  256. {Done}
  257. destructor TTextStream.Done;
  258. begin
  259.     TBufStream.Done;
  260.   FreeMem(ARecord,32000);
  261. end;
  262.  
  263. {GetNext}  {replace unwanted control chars with spaces 10/5/91}
  264. function TTextStream.GetNext:PChar;
  265. var
  266.     Blksize:Integer;
  267.   AChar:Char;
  268.   Indx : Integer;
  269.   IsEOR : Boolean;
  270. begin
  271.     Indx := 0;
  272.   IsEOR := False;
  273.   ARecord[0] := #0;
  274.   while (CharsRead < CharsToRead) and (IsEOR = False) do
  275.       begin
  276.       TBufStream.Read(AChar,1);
  277.     Inc(CharsRead);
  278.     case AChar of
  279.       #13:
  280.           begin
  281.         ARecord[Indx] := #0;
  282.         IsEOR := True;
  283.         end;
  284.         #26:
  285.           begin
  286.         if Indx > 0 then
  287.             begin
  288.           ARecord[Indx] := #0;
  289.           IsEOR := True;
  290.           end;
  291.         end;
  292.       #10:
  293.           begin
  294.         end;
  295.       #9:
  296.           begin
  297.         ARecord[Indx] := AChar;
  298.         Inc(Indx);
  299.         end;
  300.       #0..#31:
  301.           begin
  302.         ARecord[Indx] := ' ';
  303.         Inc(Indx);
  304.         end;
  305.       else
  306.           begin
  307.         ARecord[Indx] := AChar;
  308.         inc(Indx);
  309.         end;
  310.     end;
  311.   end;
  312.   ARecord[Indx] := #0;
  313.   GetNext := ARecord;
  314. end;
  315.  
  316. {WriteNext}
  317. {This method not actually used due to performance loss - instead
  318.    TStream.Write is called directly}
  319. function TTextStream.WriteNext(szARecord:PChar):Integer;
  320. const
  321.   CRLF : Array[0..2] of Char = #13#10#0;
  322.  
  323. begin
  324.     TBufStream.Write(szARecord,
  325.     StrLen(szARecord));
  326.     TBufStream.Write(CRLF,2);
  327.     WriteNext := StrLen(szARecord);
  328. end;
  329.  
  330. {WriteEOF}
  331. function TTextStream.WriteEOF:Integer;
  332. const
  333.       EOF : Array[0..1] of Char  = #26;
  334. begin
  335.     TBufStream.Write(EOF,1);
  336.    WriteEOF := 1;
  337. end;
  338.  
  339. {IsEOF}
  340. function TTextStream.IsEOF:Boolean;
  341. begin
  342.     IsEOF := False;
  343.     if CharsRead >= CharsToRead then
  344.        IsEOF := True;
  345. end;
  346.  
  347. {GetPctDone}
  348. function TTextStream.GetPctDone:Integer;
  349. begin
  350.     GetPctDone := CharsRead*100 div CharsToRead;
  351. end;
  352.  
  353.  
  354. {**********************************************************************}
  355. {TMeterWindow Methods}
  356. {Init}
  357. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  358. begin
  359.     TWindow.Init(AParent,ATitle);
  360.   DisableAutoCreate;
  361.      ThePen := CreatePen(ps_Solid,0,$00000000);
  362.   TheGrayBrush := CreateSolidBrush($00C0C0C0);
  363.   TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  364.   with Attr do
  365.        begin
  366.       X := 100;Y :=100 ;W := 350;H := 95;
  367.       Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  368.        end;
  369.   X := 50;
  370.   Y := 10;
  371.   dX := 275;
  372.   dY := 30;
  373.   mX := 50;   {midpoint between X & X+dX}
  374.   PctDone := 0;
  375. end;
  376.  
  377. procedure TMeterWindow.SetupWindow;
  378. begin
  379.     TWindow.SetupWindow;
  380.     Icon :=LoadIcon(HInstance,'WOP_Icon1');
  381. end;
  382.  
  383. {Done}
  384. destructor TMeterWindow.Done;
  385. begin
  386.      DeleteObject(TheGrayBrush);
  387.   DeleteObject(TheRedBrush);
  388.   DeleteObject(ThePen);
  389.   Destroy;
  390.   TWindow.Done;
  391. end;
  392.  
  393. procedure TMeterWindow.Draw(NewPctDone:Integer);
  394. var
  395. Rgn:TRect;
  396. begin
  397.     PctDone := NewPctDone;
  398.     If PctDone > 0 then
  399.        mX :=  X + ((dX * PctDone) div 100)
  400.    else
  401.        mX := X;
  402.    Rgn.Left := X;
  403.    Rgn.Top := Y;
  404.    Rgn.Right := Max(210,mx);
  405.    Rgn.Bottom := Y+dY+20;
  406.    InvalidateRect(HWindow,@Rgn,false);
  407.    UpdateWindow(HWindow); 
  408. end;
  409.  
  410. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  411. var
  412.     OldBrush : HBrush;
  413.   OldPen :HPen;
  414.   OldColor : LongInt;
  415.   OldBkMode : Integer;
  416.   Buf  : Array[0..6] of Char;
  417. begin
  418.     DrawIcon(PaintDC,10,10,Icon);
  419.   OldPen := SelectObject(PaintDC,ThePen);
  420.   OldBrush := SelectObject(PaintDC,TheGrayBrush);
  421.   Rectangle(PaintDC,X,Y,mX,Y+dY);
  422.   Str(PctDone:2, Buf);
  423.   StrCat(Buf,'%');
  424.   SetTextAlign(PaintDC,ta_left);
  425.   OldColor := SetTextColor(PaintDC,RGB(255,0,0));  {Red}
  426.   {OldBkMode := SetBkMode(PaintDC,Transparent);}
  427.   TextOut(PaintDC,180,42,Buf,StrLen(Buf));
  428.   SelectObject(PaintDC,OldBrush);
  429.   SelectObject(PaintDC,OldPen);
  430.   SetTextColor(PaintDC,Oldcolor);
  431.   {SetBkMode(PaintDC,OldBkMode);}
  432. end;
  433.  
  434. {***********************************************************************}
  435. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  436.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  437. begin
  438.     TWindow.Init(AParent,ATitle);
  439.   Attr.Style := ws_Child or ws_visible ;
  440.   Attr.X := NewX;
  441.   Attr.Y := NewY;
  442.   Attr.W := NewW;
  443.   Attr.H := NewH;
  444.   Attr.ID := AnID;
  445.   W := NewW;
  446.   H := NewH;
  447.   if NewState = sr_Recessed then
  448.       State := sr_Recessed
  449.     else
  450.         State := sr_Raised;
  451. end;
  452.  
  453. destructor TSRect.Done;
  454. begin
  455.     TWindow.Done;
  456. end;
  457.  
  458. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  459. var
  460.   LPts:Array[0..2] of TPoint;
  461.   RPts:Array[0..2] of TPoint;
  462.     ThePen:HPen;
  463.   Pen1:HPen;
  464.   Pen2:HPen;
  465.   TheBrush :HBrush;
  466.   OldBrush :HBrush;
  467.   OldPen:HPen;
  468.   OldBkMode:Integer;
  469.   DRect:TRect;
  470.   Ofs:Integer;
  471. begin
  472.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  473.   OldBrush := SelectObject(PaintDC,TheBrush);
  474.   Rectangle(PaintDC,0,0,W,H);
  475.   SelectObject(PaintDC,OldBrush);
  476.  
  477.   Ofs := 0;
  478.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  479.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  480.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  481.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  482.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  483.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  484.  
  485.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  486.   OldPen := SelectObject(PaintDC,Pen1);
  487.   PolyLine(PaintDC,LPts,3);
  488.   PolyLine(PaintDC,RPts,3);
  489.   SelectObject(PaintDC,OldPen);
  490.   DeleteObject(Pen1);
  491.  
  492.   Ofs := 1;
  493.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  494.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  495.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  496.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  497.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  498.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  499.   if State = sr_Raised then
  500.       begin
  501.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  502.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  503.     end
  504.   else
  505.       begin
  506.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  507.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  508.     end;
  509.  
  510.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  511.   PolyLine(PaintDC,LPts,3);
  512.   SelectObject(PaintDC,Pen2);
  513.   DeleteObject(Pen1);
  514.  
  515.   PolyLine(PaintDC,RPts,3);
  516.   SelectObject(PaintDC,OldPen);
  517.   DeleteObject(Pen2);
  518. end;
  519.  
  520. procedure TSRect.SetupWindow;
  521. begin
  522.  
  523. end;
  524. {***********************************************************************}
  525. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  526.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  527. begin
  528.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  529.   DTStyle := NewStyle;
  530.   StrCopy(Text,ATitle);
  531. end;
  532.  
  533. destructor TSText.Done;
  534. begin
  535.     TSRect.Done;
  536. end;
  537.  
  538. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  539. var
  540.   OldBkMode:Integer;
  541.   DRect:TRect;
  542. begin
  543.   TSRect.Paint(PaintDC,PaintInfo);
  544.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  545.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  546.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  547.   SetBkMode(PaintDC,OldBkMode);
  548. end;
  549.  
  550. procedure TSText.SetText(NewText:PChar);
  551. var
  552.     DRect:TRect;
  553. begin
  554.     StrCopy(Text,NewText);
  555.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  556.   InvalidateRect(HWindow,@DRect,false);
  557. end;
  558.  
  559.  
  560. end.
  561.